Delitos en época de COVID19

Row

Tabla de incidencia

Tipo de delito Incidencia en 2019 Incidencia en 2020 Porcentaje de cambio
Acoso sexual 4204 5597 33.14
Otros delitos que atentan contra la libertad y la seguridad sexual 6325 8032 26.99
Violación equiparada 3674 4225 15
Violencia familiar 210158 220039 4.7
Trata de personas 544 550 1.1
Feminicidio 943 939 -0.42
Homicidio doloso 29456 28808 -2.2
Abuso sexual 23625 22379 -5.27
Hostigamiento sexual 1860 1753 -5.75
Violación simple 13656 12320 -9.78
Lesiones dolosas 166440 144280 -13.31
Tráfico de menores 29 21 -27.59
Secuestro 1331 826 -37.94

Delitos sexuales y de género

Todos los delitos

Row

Cambio en la incidencia

Mapa nacional 1 y pruebas realizadas

Row

Mapa nacional de resultados positivos

Row

Pruebas realizadas por estado

Pruebas realizadas por estado

ENTIDAD_FEDERATIVA Numero de pruebas
AGUASCALIENTES 83487
BAJA CALIFORNIA 108960
BAJA CALIFORNIA SUR 92294
CAMPECHE 32006
CHIAPAS 36107
CHIHUAHUA 100400
CIUDAD DE MÉXICO 2269646
COAHUILA DE ZARAGOZA 164356
COLIMA 25354
DURANGO 80050
GUANAJUATO 293806
GUERRERO 86172
HIDALGO 72614
JALISCO 197251
MÉXICO 707245
MICHOACÁN DE OCAMPO 127388
MORELOS 149283
NAYARIT 25208
NUEVO LEÓN 280354
OAXACA 73034
PUEBLA 182559
QUERÉTARO 137874
QUINTANA ROO 53342
SAN LUIS POTOSÍ 167962
SINALOA 84891
SONORA 127854
TABASCO 209122
TAMAULIPAS 145289
TLAXCALA 63283
VERACRUZ DE IGNACIO DE LA LLAVE 125993
YUCATÁN 97636
ZACATECAS 62681

Mapa porcentaje de positividad

Row

Porcentaje total

Row

Porcentaje 2020

Porcentaje 2021

Ranking Nacional

Calificación por estado para manejo de la pandemia

# A tibble: 448 x 5
# Groups:   ENTIDAD_FEDERATIVA [32]
   FECHA_INGRESO ENTIDAD_RES ENTIDAD_FEDERATIVA FECHA_DEF  POSITIVOS
   <date>        <chr>       <chr>              <date>         <int>
 1 2021-04-28    01          AGUASCALIENTES     NA                36
 2 2021-04-29    01          AGUASCALIENTES     NA                28
 3 2021-04-30    01          AGUASCALIENTES     NA                19
 4 2021-05-01    01          AGUASCALIENTES     NA                 4
 5 2021-05-02    01          AGUASCALIENTES     NA                 8
 6 2021-05-03    01          AGUASCALIENTES     NA                29
 7 2021-05-04    01          AGUASCALIENTES     NA                19
 8 2021-05-05    01          AGUASCALIENTES     NA                20
 9 2021-05-06    01          AGUASCALIENTES     NA                34
10 2021-05-07    01          AGUASCALIENTES     NA                18
# ... with 438 more rows
# A tibble: 448 x 5
# Groups:   ENTIDAD_FEDERATIVA [32]
   FECHA_INGRESO ENTIDAD_RES ENTIDAD_FEDERATIVA FECHA_DEF  MUERTES
   <date>        <chr>       <chr>              <date>       <int>
 1 2021-04-20    01          AGUASCALIENTES     2021-04-20       1
 2 2021-04-21    01          AGUASCALIENTES     2021-04-24       4
 3 2021-04-22    01          AGUASCALIENTES     2021-05-01       3
 4 2021-04-23    01          AGUASCALIENTES     2021-04-30       3
 5 2021-04-25    01          AGUASCALIENTES     2021-05-02       3
 6 2021-04-26    01          AGUASCALIENTES     2021-04-27       2
 7 2021-04-27    01          AGUASCALIENTES     2021-05-01       2
 8 2021-04-28    01          AGUASCALIENTES     2021-05-03       1
 9 2021-04-29    01          AGUASCALIENTES     2021-05-02       5
10 2021-04-30    01          AGUASCALIENTES     2021-05-05       2
# ... with 438 more rows
ESTADO AVERAGE
CHIAPAS 100.00000
CAMPECHE 98.97768
NAYARIT 98.66647
COLIMA 97.96101
TLAXCALA 96.83404
QUINTANA ROO 96.39046
AGUASCALIENTES 95.40907
ZACATECAS 94.83780
MORELOS 94.69973
DURANGO 94.51893
GUERRERO 94.26782
HIDALGO 94.00476
YUCATÁN 93.94365
SINALOA 93.82032
OAXACA 93.69631
MICHOACÁN DE OCAMPO 93.23735
BAJA CALIFORNIA SUR 92.30561
BAJA CALIFORNIA 92.18821
CHIHUAHUA 91.39801
VERACRUZ DE IGNACIO DE LA LLAVE 91.22655
TAMAULIPAS 91.02176
SAN LUIS POTOSÍ 89.47649
TABASCO 88.70515
COAHUILA DE ZARAGOZA 88.63959
QUERÉTARO 88.22066
SONORA 87.44425
PUEBLA 87.03535
JALISCO 86.95158
NUEVO LEÓN 80.82779
GUANAJUATO 79.83304
MÉXICO 60.79328
CIUDAD DE MÉXICO 0.00000

Comparativa entre países (Contagios)

Column

Escenario mundial (población similar)

Column

Escenario LATAM

Vacunación en LATAM

Row

Escenario general

Estacionalidad (Mensual)

Estacionalidad (semanal por mes)

Vacunación en LATAM (Pronósticos)

Column

TSLM

<TSLM model definition>
# A mable: 13 x 2
# Key:     location [13]
   location           Modelo_tendencia
   <chr>                       <model>
 1 Argentina                    <TSLM>
 2 Bolivia                      <TSLM>
 3 Brazil                       <TSLM>
 4 Chile                        <TSLM>
 5 Colombia                     <TSLM>
 6 Costa Rica                   <TSLM>
 7 Dominican Republic           <TSLM>
 8 Ecuador                      <TSLM>
 9 Guatemala                    <TSLM>
10 Mexico                       <TSLM>
11 Panama                       <TSLM>
12 Paraguay                     <TSLM>
13 Peru                         <TSLM>
# A mable: 13 x 2
# Key:     location [13]
   location           Modelo_tendencia
   <chr>                       <model>
 1 Argentina                    <TSLM>
 2 Bolivia                      <TSLM>
 3 Brazil                       <TSLM>
 4 Chile                        <TSLM>
 5 Colombia                     <TSLM>
 6 Costa Rica                   <TSLM>
 7 Dominican Republic           <TSLM>
 8 Ecuador                      <TSLM>
 9 Guatemala                    <TSLM>
10 Mexico                       <TSLM>
11 Panama                       <TSLM>
12 Paraguay                     <TSLM>
13 Peru                         <TSLM>
# A fable: 195 x 5 [1D]
# Key:     location, .model [13]
   location  .model           Daily      total_vaccinations_per_hundred .mean
   <chr>     <chr>            <date>                             <dist> <dbl>
 1 Argentina Modelo_tendencia 2021-05-13                     N(18, 4.4)  17.5
 2 Argentina Modelo_tendencia 2021-05-14                     N(18, 4.4)  17.7
 3 Argentina Modelo_tendencia 2021-05-15                     N(18, 4.4)  17.9
 4 Argentina Modelo_tendencia 2021-05-16                     N(18, 4.4)  18.0
 5 Argentina Modelo_tendencia 2021-05-17                     N(18, 4.4)  18.2
 6 Argentina Modelo_tendencia 2021-05-18                     N(18, 4.4)  18.4
 7 Argentina Modelo_tendencia 2021-05-19                     N(19, 4.5)  18.5
 8 Argentina Modelo_tendencia 2021-05-20                     N(19, 4.5)  18.7
 9 Argentina Modelo_tendencia 2021-05-21                     N(19, 4.5)  18.9
10 Argentina Modelo_tendencia 2021-05-22                     N(19, 4.5)  19.1
# ... with 185 more rows
# A fable: 195 x 5 [1D]
# Key:     location, .model [13]
   location  .model           Daily      total_vaccinations_per_hundred .mean
   <chr>     <chr>            <date>                             <dist> <dbl>
 1 Argentina Modelo_tendencia 2021-05-13                     N(17, 5.2)  16.7
 2 Argentina Modelo_tendencia 2021-05-14                     N(17, 5.2)  16.9
 3 Argentina Modelo_tendencia 2021-05-15                     N(17, 5.2)  17.0
 4 Argentina Modelo_tendencia 2021-05-16                     N(17, 5.2)  17.2
 5 Argentina Modelo_tendencia 2021-05-17                     N(17, 5.2)  17.3
 6 Argentina Modelo_tendencia 2021-05-18                     N(17, 5.2)  17.5
 7 Argentina Modelo_tendencia 2021-05-19                     N(18, 5.2)  17.6
 8 Argentina Modelo_tendencia 2021-05-20                     N(18, 5.2)  17.8
 9 Argentina Modelo_tendencia 2021-05-21                     N(18, 5.2)  18.0
10 Argentina Modelo_tendencia 2021-05-22                     N(18, 5.2)  18.1
# ... with 185 more rows

Column

ETS

---
title: "COVID19 Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
    social: [ "twitter", "facebook", "menu"]
    source_code: embed
---

```{r setup, include=FALSE}
library(flexdashboard)
# library(knitr)

#integrar visualización
library(patchwork)

library(DT)
library(rpivotTable)
library(ggplot2)
library(plotly)
library(dplyr)
library(openintro)
library(highcharter)
library(ggvis)
library(tidyverse)
# library(tibbletime)
library(reactable)
library(htmltools)
library(fpp3)
library(feasts)
library(fable)
library(tsibble)
library(lubridate)
library(kableExtra)
library(formattable)
#importación y lectura
library(readxl)
library(tidyr)
library(vroom)
#Mapas
library(leaflet)
library(ggmap) # -> para obtener lon y lat de los municipios
library(raster)
library(spData)
library(tmap)
library(RJSONIO)
library(tmaptools)
library(Hmisc)
library(mxmaps) #se instala con un repo de gitgub con el 
                #siguiente comando
                #if (!require("devtools")) {
#     install.packages("devtools")
# }
# devtools::install_github("diegovalle/mxmaps")

library(sf)
library(scales) # needed for comma
library(rgeos)
library(maptools)
library(leaflet)
library(geojsonio)
library(jsonlite)

```


```{r}
# 
# data <- read_csv("VehicleFailure.csv")
  
delitos <- read_csv("../Delitos/delitos2015-2021.csv", 
                    locale(encoding = "latin1"),
                    col_names = TRUE, 
                    col_types = NULL
                 )
  #######Quedarse solo con las columnas y filas necesarias#######

delitos_a_comparar <- c("Feminicidio", "Abuso sexual", 
                        "Acoso sexual", "Hostigamiento sexual",
                        "Otros delitos que atentan contra la libertad y la seguridad sexual",
                        "Violación simple", "Violación equiparada", "Trata de personas",
                        "Tráfico de menores", "Secuestro", "Violencia familiar")

delitos_tidy <- delitos %>%
  filter( Tipo_de_delito %in% delitos_a_comparar | 
          Subtipo_de_delito == "Homicidio doloso" |
          Subtipo_de_delito == "Lesiones dolosas" ) %>% 
  pivot_longer(
  cols = Enero:Diciembre ,
  names_to = "Meses",
  values_to = "Cuenta"
) %>% 
  group_by(Ano, Meses, Tipo_de_delito, Subtipo_de_delito) %>% 
  summarise(Cuenta = sum(Cuenta), .groups = "drop")

delitos_tidy <- delitos_tidy %>% 
  mutate(
    Meses = str_trunc(Meses, width = 3, ellipsis = ""),
    Meses = case_when(
      Meses == "Ene" ~ "Jan",
      Meses == "Abr" ~ "Apr",
      Meses == "Ago" ~ "Aug",
      Meses == "Dic" ~ "Dec",
      TRUE           ~ Meses
    )
  ) %>% 
  unite(col = "Fecha", c(Ano,Meses), sep = " ") %>% 
  mutate(Fecha = yearmonth(Fecha))

delitos_tidy_tsbl <- delitos_tidy %>% 
  as_tsibble(
    index = Fecha,
    key   = c(Tipo_de_delito, Subtipo_de_delito)
  )
# 
# mycolors <- c("blue", "#FFC125", "darkgreen", "darkorange")
```

Delitos en época de COVID19
=====================================



























































Row
-------------------------------

### Tabla de incidencia

```{r}


#Tabla de incidencia (old)
# 
# Incidencia_2019 <-delitos_tidy_tsbl %>% 
#   tsibble::group_by_key() %>% 
#   tsibble::index_by(Año = year(Fecha)) %>% 
#   dplyr::summarise(Cuenta = sum(Cuenta)) %>% 
#   dplyr::filter(Año %in% 2019) %>%
#   dplyr::as_tibble(Incidencia_2019) %>%
#   dplyr::transmute( Delito = Tipo_de_delito, 
#                     Incidencia_2019 = Cuenta) 
# 
# Incidencia_2020 <- delitos_tidy_tsbl %>%
#   group_by_key() %>%
#   
#   index_by(Año = year(Fecha)) %>%
#   
#   dplyr::summarise(Cuenta = sum(Cuenta)) %>%
#   dplyr::filter(Año %in% 2020) %>%
#   dplyr::as_tibble(Incidencia_2020) %>%
#   dplyr::mutate(Delito = Tipo_de_delito,
#         Incidencia_2020 = Cuenta) %>%
#   dplyr::select(Delito, Incidencia_2020)
# 
# Incidencia <- Incidencia_2020 %>%
#   add_column(Incidencia_2019$Incidencia_2019) %>%
#   dplyr::mutate(
#     Porcentaje_de_cambio = round((
#       (Incidencia_2020 - Incidencia_2019$Incidencia_2019)/Incidencia_2020), digits = 5),
#     Incidencia_2019 = Incidencia_2019$Incidencia_2019) %>%
#   
#   dplyr::select(Delito, Incidencia_2019, Incidencia_2020, Porcentaje_de_cambio)%>%
#   arrange(desc(Porcentaje_de_cambio)) 
#  
# Tabla <- Incidencia %>%
#   mutate(Porcentaje_de_cambio =  percent(Porcentaje_de_cambio, 2)) %>%
#   kbl(fortmat = "htlm", col.names = c("Delitos",
#                                       "Incidencia en 2019",
#                                       "Incidencia en 2020",
#                                       "Porcentaje de cambio")) %>%
#   
#   kable_styling(bootstrap_options = "striped",
#                 full_width = F,
#                 position = "left",
#                 font_size = 14) %>%
#   
#   column_spec(4,color = ifelse( Incidencia$Porcentaje_de_cambio > 0, "red", "green"))
# Tabla


#Tabla de incidencia (new -> 13/marzo/2021)

incidencias <- delitos_tidy_tsbl %>% 
  group_by_key() %>% 
  index_by(Año = year(Fecha)) %>% 
  summarise(Cuenta = sum(Cuenta)) %>% 
  as_tibble(incidencias) %>% 
  mutate(cambio = (Cuenta / lag(Cuenta) - 1)*100) %>% 
  filter(Año != 2021)

Todos_delitos_gg <- incidencias %>% 
  ggplot(aes(x = Año, y = Cuenta, color = Tipo_de_delito)) +
  geom_line(size = 1)+
  facet_wrap(~ Tipo_de_delito, scales = "free_y") +
  theme(legend.position = "none")

# perc_cambio_incidencias <- incidencias %>%
#   ggplot(aes(x = Año, y = cambio, color = Subtipo_de_delito)) +
#   geom_line() +
#   geom_line(size = 1)+
#   facet_wrap(~ Subtipo_de_delito, scales = "free_y") +
#   theme(legend.position = "none")
# plotly::ggplotly(perc_cambio_incidencias)

incidencias <- incidencias %>% 
  pivot_wider(names_from = Año, values_from = Cuenta:cambio)

Tabla <- incidencias %>%
  dplyr::select( Subtipo_de_delito, Cuenta_2019, Cuenta_2020, cambio_2020) %>%
  arrange(-cambio_2020) %>%
  transmute('Tipo de delito' = Subtipo_de_delito,
            'Incidencia en 2019' = Cuenta_2019,
            'Incidencia en 2020' = Cuenta_2020,
            'Porcentaje de cambio' =  round(cambio_2020, digits = 2))

customGreen0 = "#DeF7E9"

customGreen = "#71CA97"

customRed = "#ff7f7f"

cambio_format <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold",
              color = ifelse(x < 0, customGreen, ifelse(x > 0, customRed, "black"))),
            x ~ icontext(ifelse(x>0, "arrow-up", "arrow-down"), x)
  ) 

formattable(Tabla, 
            align = c("l", rep("r", NCOL(Tabla) - 1)),
            list('Tipo de delito' = formatter("span", style = ~ formattable::style(color = "grey", font.weight = "bold")),
                 'Porcentaje de cambio' = cambio_format
            ))
 


```


### Delitos sexuales y de género

```{r}

sexuales_y_genero = c("Abuso sexual", 
                      "Acoso sexual",
                      "Feminicidio", 
                      "Violación simple", 
                      "Violación equiparada", 
                      "Hostigamiento sexual", 
                      "Otros delitos que atentan contra la libertad y la seguridad sexual")

# Grafica old
# p2 <-  delitos_tidy_tsbl %>%
#   filter (Tipo_de_delito %in% sexuales_y_genero) %>%
#   ggplot() + 
#   geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))
# 
# p2

delitos_sexuales_y_genero_gg <- delitos_tidy_tsbl %>%
  filter (Tipo_de_delito %in% sexuales_y_genero) %>%
  ggplot(aes(x = Fecha, y = Cuenta, color = Tipo_de_delito)) +
  geom_line(size = 1)+
  facet_wrap(~ Tipo_de_delito, scales = "free_y") +
  theme(legend.position = "none")

delitos_sexuales_y_genero_gg
```

```{r}
#CargaDeDatos para generar gráficas de los delitos totales y en tasa de cambio

incidencias <- delitos_tidy_tsbl %>% 
  group_by_key() %>% 
  index_by(Anual = year(Fecha)) %>% 
  summarise(Cuenta = sum(Cuenta)) %>% 
  as_tibble(incidencias) %>% 
  mutate(cambio = (Cuenta / lag(Cuenta) - 1)*100) %>% 
  filter(Anual != 2021)

```


### Todos los delitos

```{r}
#gráfica old, delitos contra la libertad
# p3 <- delitos_tidy_tsbl %>%
#   filter (Tipo_de_delito %in% c("Trata de personas", "Tráfico de menores", "Secuestro") ) %>%
#   ggplot() + 
#   geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))
# 
# p3

Todos_delitos_gg <- incidencias %>% 
  ggplot(aes(x = Anual, y = Cuenta, color = Tipo_de_delito)) +
  geom_line(size = 1)+
  facet_wrap(~ Tipo_de_delito, scales = "free_y") +
  theme(legend.position = "none")

Todos_delitos_gg
```

Row
------------------------------------
### Cambio en la incidencia  

```{r}
# gráfica old, delitos dolosos 
# p4 <- delitos_tidy_tsbl %>%
#   filter(Subtipo_de_delito %in% c("Lesiones dolosas", "Homicidio doloso")) %>%
#   ggplot() + 
#   geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))
# 
# p4

perc_cambio_incidencias <- incidencias %>%
  ggplot(aes(x = Anual, y = cambio, color = Subtipo_de_delito)) +
  geom_line() +
  geom_line(size = 1)+
  facet_wrap(~ Subtipo_de_delito, scales = "free_y") +
  theme(legend.position = "none")
plotly::ggplotly(perc_cambio_incidencias)
```













Mapa nacional 1 y pruebas realizadas
========================================

Row
------------------------------------

### Mapa nacional de resultados positivos 

```{r}
# car <- data %>%
#          group_by(State) %>%
#          summarize(total = n())
# car$State <- abbr2state(car$State)
# 
# highchart() %>%
#          hc_title(text = "Car Failures in US") %>%
#          hc_subtitle(text = "Source: Vehiclefailure.csv") %>%
#          hc_add_series_map(usgeojson, car,
#                            name = "State",
#                            value = "total",
#                            joinBy = c("woename", "State")) %>%

#          hc_mapNavigation(enabled = T)
# lubridate::today()-1
# fecha <- "210415"
options(timeout = 700)
temp <- tempfile()
download.file("http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip", temp)


Datosmex2502 <- vroom::vroom(unz(temp, unzip(temp, list = TRUE) %>% pull(Name)))
unlink(temp)

```


```{r}

Entidades <- read_xlsx("../Datos nacionales abiertos/201128 Catalogos.xlsx",sheet="Catálogo de ENTIDADES")

# Clasificación de datos  -------------------------------------------------

#datos necesarios para la prueba
datosimportates <- dplyr::select(Datosmex2502,`FECHA_INGRESO`,`ENTIDAD_RES`,
                                 `TOMA_MUESTRA_LAB`,`RESULTADO_LAB`, `TOMA_MUESTRA_ANTIGENO`,
                                 `RESULTADO_ANTIGENO`, `CLASIFICACION_FINAL`)%>%
  left_join(Entidades, by=c("ENTIDAD_RES"="CLAVE_ENTIDAD"))

#datos confirmados sin realización de pruebas
confirmados <- datosimportates %>% 
  filter(`CLASIFICACION_FINAL`%in% c(1,2,3)) %>% 
  dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `ABREVIATURA`) %>% 
  mutate(
    year = lubridate::year(FECHA_INGRESO),
    month = lubridate::month(FECHA_INGRESO),
    day = lubridate::day(FECHA_INGRESO)
  ) %>% 
  drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) 

# Agrupación de datos  ----------------------------------------------------
#Numero de positivos por estado
positivosestado <- confirmados %>%
  group_by(`ENTIDAD_RES`) %>%
  summarise(
    count=n(),
  )

#Selección de nombre estados, por orden de codigo
nombreEstado <- Entidades %>%
  dplyr::select(`ENTIDAD_FEDERATIVA`) %>%
  slice( 1:32)

mapaPositivos <- positivosestado %>%
  add_column(nombreEstado)

# Mapa  -------------------------------------------------------------------

# data(mapaPositivos)
# mapaPositivos$rand <- mapaPositivos$count
# mapaPositivos$region <- mapaPositivos$ENTIDAD_RES
# mxstate_choropleth(mapaPositivos,
#                    title = "Casos confirmados de COVID por estado.",
#                    legend = "Número de casos.",
# )


# Convert the topoJSON to spatial object
tmpdir <- tempdir()
# have to use RJSONIO or else the topojson isn't valid
write(RJSONIO::toJSON(mxstate.topoJSON), file.path(tmpdir, "sta.topojson"))
mxstate <- topojson_read(file.path(tmpdir, "sta.topojson")) 


#ordenamos los datos del topoJSON en orden numérico
mxstate <- mxstate[order(mxstate$id),]


mxstate <- as_Spatial(mxstate)

mxstate$rand <- mapaPositivos$count

bins <- c(5000,20000 , 30000, 35000, 50000, 60000, 115000,300000, Inf)
pal <- colorBin("YlOrRd", domain = mxstate$rand, bins=bins)


etiqueta <- paste(
  "Estado: ", mapaPositivos$ENTIDAD_FEDERATIVA, "
", "Número de casos: ", mapaPositivos$count ) %>% lapply(htmltools::HTML) leaflet(mxstate) %>% addPolygons( fillColor = ~pal(mxstate$rand), fillOpacity = 1, stroke = TRUE, color = "White", weight = 1.5, dashArray = "3", highlight = highlightOptions( weight = 5, color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE), label = etiqueta, )%>% addLegend(pal = pal, values = ~mapaPositivos$rand, opacity = 0.7, title = "Casos
positivos
contagios", position = "bottomright")%>% addTiles() %>% addMarkers(50, 50) %>% addControl("Positivos totales COVID19 México", position = "bottomleft") %>% addProviderTiles("CartoDB.Positron") ``` Row ------------------------------------ ### Pruebas realizadas por estado ```{r} # # Importación de datos ---------------------------------------------------- # # # # Datosmex2502 <- read_csv("210225COVID19MEXICO.csv") # # Descarga de datos desde la página web # fecha <- "210412" # options(timeout = 600) # temp <- tempfile() # download.file("http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip", temp) # # # Datosmex2502 <- vroom::vroom(unz(temp, paste0(fecha,"COVID19MEXICO.csv"))) # unlink(temp) # # # Entidades <- read_xlsx("Datos nacionales abiertos/201128 Catalogos.xlsx",sheet="Catálogo de ENTIDADES") # # Clásificación ---------------------------------------------------------- # # #datos necesarios para la prueba # datosimportates <- dplyr::select(Datosmex2502,`FECHA_INGRESO`,`ENTIDAD_RES`, # `TOMA_MUESTRA_LAB`,`RESULTADO_LAB`, `TOMA_MUESTRA_ANTIGENO`, # `RESULTADO_ANTIGENO`, `CLASIFICACION_FINAL`)%>% # left_join(Entidades, by=c("ENTIDAD_RES"="CLAVE_ENTIDAD")) #datos de las pruebas realizadas ese día en todo el país pruebasfiltro <- datosimportates %>% dplyr::filter(`TOMA_MUESTRA_LAB`== 1 | `TOMA_MUESTRA_ANTIGENO`==1 ) %>% dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`,`ENTIDAD_FEDERATIVA`,`ABREVIATURA`) %>% mutate( year = lubridate::year(FECHA_INGRESO), month = lubridate::month(FECHA_INGRESO), day = lubridate::day(FECHA_INGRESO) ) %>% drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) # Agrupación de datos ---------------------------------------------------- #Numero de pruebas por estado totales hasta la fecha de datos pruebasXEstado <- pruebasfiltro %>% group_by(`ENTIDAD_FEDERATIVA`) %>% mutate(`Numero de pruebas`=n()) %>% distinct(`ENTIDAD_FEDERATIVA`, .keep_all = TRUE) %>% arrange(`ENTIDAD_FEDERATIVA`) %>% drop_na(`ENTIDAD_FEDERATIVA`) pruebasXEstado <- pruebasXEstado %>% dplyr::select( `ENTIDAD_FEDERATIVA`, `Numero de pruebas` ) pruebasfiltro$FECHA_INGRESO <- format(pruebasfiltro$FECHA_INGRESO, "%Y-%m") #Numero de pruebas por estado según el día pruebasxEstadoxDia <- pruebasfiltro %>% group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% mutate(count=n()) %>% distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% arrange(`ENTIDAD_RES`) %>% drop_na(`ENTIDAD_FEDERATIVA`) # Gráfica ---------------------------------------------------------------- ggplot(data = pruebasfiltro) + geom_bar(mapping = aes(y = FECHA_INGRESO, fill = ABREVIATURA), position = "dodge") ``` ### Pruebas realizadas por estado ```{r} # Tabla ------------------------------------------------------------------ #Tabla que muestra el número de pruebas que se hacen por día en los estados formattable(pruebasXEstado, #llamo datos align =c("l","c"), #Para alinear los datos de la tabla cada "" es una columna list(`ENTIDAD_FEDERATIVA` = formatter( #datos específicos "span", style = ~ style(color = "grey",font.weight = "bold")), `Numero de pruebas` = color_bar("Red") # me crea una barra roja con proporción a los datos ) ) ``` Mapa porcentaje de positividad ======================================== Row ------------------------------------ ### Porcentaje total ```{r} # Importación de datos ---------------------------------------------------- #Datosmex2502 <- read_csv("210225COVID19MEXICO.csv") # Descarga de datos desde la página web # fecha <- "210414" # options(timeout = 700) # temp <- tempfile() # download.file("http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip", temp) # # # Datosmex2502 <- vroom::vroom(unz(temp, unzip(temp, list = TRUE) %>% pull(Name))) # unlink(temp) # # # Entidades <- read_xlsx("Datos nacionales abiertos/201128 Catalogos.xlsx",sheet="Catálogo de ENTIDADES") # # # Clasificación de datos ------------------------------------------------- # # #datos necesarios para la prueba # datosimportates <- dplyr::select(Datosmex2502,`FECHA_INGRESO`,`ENTIDAD_RES`, # `TOMA_MUESTRA_LAB`,`RESULTADO_LAB`, `TOMA_MUESTRA_ANTIGENO`, # `RESULTADO_ANTIGENO`, `CLASIFICACION_FINAL`)%>% # left_join(Entidades, by=c("ENTIDAD_RES"="CLAVE_ENTIDAD")) # # # # #datos confirmados sin realización de pruebas # confirmados <- datosimportates %>% # filter(`CLASIFICACION_FINAL`%in% c(1,2,3)) %>% # dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `ABREVIATURA`) %>% # mutate( # year = lubridate::year(FECHA_INGRESO), # month = lubridate::month(FECHA_INGRESO), # day = lubridate::day(FECHA_INGRESO) # ) %>% # drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) #datos de las pruebas realizadas ese día en todo el país pruebasfiltro <- datosimportates %>% dplyr::filter(`TOMA_MUESTRA_LAB`== 1 | `TOMA_MUESTRA_ANTIGENO`==1 ) %>% dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`,`ENTIDAD_FEDERATIVA`,`ABREVIATURA`) %>% mutate( year = lubridate::year(FECHA_INGRESO), month = lubridate::month(FECHA_INGRESO), day = lubridate::day(FECHA_INGRESO) ) %>% drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) #Separación de datos por fechas para mapas pruebas2020 <- dplyr::filter(pruebasfiltro, year==2020) pruebEstado2020 <- pruebas2020 %>% group_by(`ENTIDAD_RES`) %>% summarise( count=n() ) pruebas2021 <- dplyr::filter(pruebasfiltro, year==2021) pruebEstado2021 <- pruebas2021 %>% group_by(`ENTIDAD_RES`) %>% summarise( count=n() ) #confirmados por año para mapas confirm2020 <- confirmados %>% dplyr::filter( year==2020) %>% drop_na(`ENTIDAD_FEDERATIVA`) confirmEstado2020 <- confirm2020 %>% group_by(`ENTIDAD_RES`) %>% summarise( count=n() ) confirm2021 <- confirmados %>% dplyr::filter( year==2021) %>% drop_na(`ENTIDAD_FEDERATIVA`) confirmEstado2021 <- confirm2021 %>% group_by(`ENTIDAD_RES`) %>% summarise( count=n() ) #Numero de pruebas por estado totales hasta la fecha de datos pruebasXEstado <- pruebasfiltro %>% group_by(`ENTIDAD_RES`) %>% mutate(PRUEBAS=n()) %>% distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% arrange(`ENTIDAD_RES`) %>% drop_na() # #Numero de pruebas por estado según el día # pruebasxEstadoxDia <- pruebasfiltro %>% # group_by(`ENTIDAD_RES`,`FECHA_INGRESO`) %>% # mutate(count=n()) %>% # distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% # arrange(`ENTIDAD_RES`) %>% # drop_na() # # # prubeasXEstadotsbl <- pruebasxEstadoxDia %>% # as_tsibble( key = `ENTIDAD_RES`, # index = `FECHA_INGRESO` # ) # group_split(pruebasxEstadoxDia) # group_keys(pruebasxEstadoxDia) #Positivos por estado totales hasta la fecha de datos positivoxEstado <- confirmados %>% group_by(`ENTIDAD_RES`) %>% mutate(CONFIRMADOS=n()) %>% distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% arrange(`ENTIDAD_RES`) %>% dplyr::select(ENTIDAD_RES, ENTIDAD_FEDERATIVA, CONFIRMADOS ) # #Positivos por estado según el día # positivoxEstadoxDia <- confirmados %>% # group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% # mutate(count=n()) %>% # distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% # arrange(`ENTIDAD_RES`) %>% # drop_na() # # positivoXDiatsbl <- positivoxEstadoxDia %>% # as_tsibble( key = ENTIDAD_RES, # index = FECHA_INGRESO # # ) #Selección de nombre estados, por orden de codigo nombreEstado <- Entidades %>% dplyr::select(`ENTIDAD_FEDERATIVA`) %>% slice( 1:32) # Agrupación de datos totales ----------------------------------------------------- # #suma total de las pruebas realizadas totalpruebas <- pruebasXEstado$PRUEBAS %>% sum(na.rm = TRUE) #suma total de las pruebas que salieron positivas totalpositivas <- positivoxEstado$CONFIRMADOS %>% sum(na.rm = TRUE) #Porcentaje por estado de las pruebas positivas a el total de pruebas realizadas en los estados positividadPais <- (totalpositivas/totalpruebas)*100 #positividadPais positividad <- ((positivoxEstado$CONFIRMADOS/pruebasXEstado$PRUEBAS)*100) #positividad #porcentaje total de las pruebas positivas de acuerdo a que estado. porcenestado <- (positivoxEstado$CONFIRMADOS/totalpositivas)*100 porcenestado <- as.numeric(porcenestado) #porcenestado #Porcentaje total de pruebas positvas porcen <- sum(positividad, na.rm = TRUE) #verificación de suma de porcentaje de pruebas positivas (porcenestado) sumporcentaje <- sum(porcenestado, na.rm = TRUE) # creamos tibble con datos de codigo de entidad y casos positivos nueva <- positivoxEstado %>% #agregamos porcentajes de acuerdo al total de pruebas positivas add_column(porcenestado)%>% #agregamos porcentajes del total de pruebas add_column(positividad) %>% add_column(pruebasXEstado$PRUEBAS) # #Agregamos el nombre de los estados por orden de codigo # add_column(nombreEstado) # Agrupación de datos 2020 ------------------------------------------------ # #suma total de las pruebas realizadas # totalpruebas2020 <- pruebEstado2020$count %>% # sum(na.rm = TRUE) #suma total de las pruebas que salieron positivas totalpositivas2020 <- confirmEstado2020$count %>% sum(na.rm = TRUE) #Porcentaje por estado de las pruebas positivas a el total de pruebas realizadas en los estados positividad2020 <- (confirmEstado2020$count/pruebEstado2020$count)*100 #positividad2020 #porcentaje total de las pruebas positivas de acuerdo a que estado. porcenestado2020 <- (confirmEstado2020$count/totalpositivas2020)*100 porcenestado2020 <- as.numeric(porcenestado) #porcenestado2020 #Porcentaje total de pruebas positvas porcen2020 <- sum(positividad2020, na.rm = TRUE) #verificación de suma de porcentaje de pruebas positivas (porcenestado) sumporcentaje2020 <- sum(porcenestado2020, na.rm = TRUE) # creamos tibble con datos de codigo de entidad y casos positivos nueva2020 <- confirmEstado2020 %>% #agregamos porcentajes de acuerdo al total de pruebas positivas add_column(porcenestado2020)%>% #agregamos porcentajes del total de pruebas add_column(positividad2020) %>% #Agregamos el nombre de los estados por orden de codigo add_column(nombreEstado) # Agrupación de datos 2021 ------------------------------------------------ # #suma total de las pruebas realizadas # totalpruebas2021 <- pruebEstado2021$count %>% # sum(na.rm = TRUE) #suma total de las pruebas que salieron positivas totalpositivas2021 <- confirmEstado2021$count %>% sum(na.rm = TRUE) #Porcentaje por estado de las pruebas positivas a el total de pruebas realizadas en los estados positividad2021 <- (confirmEstado2021$count/pruebEstado2021$count)*100 #positividad2021 #porcentaje total de las pruebas positivas de acuerdo a que estado. porcenestado2021 <- (confirmEstado2021$count/totalpositivas2021)*100 porcenestado2021 <- as.numeric(porcenestado2021) #porcenestado2021 #Porcentaje total de pruebas positvas porcen2021 <- sum(positividad2021, na.rm = TRUE) #verificación de suma de porcentaje de pruebas positivas (porcenestado) sumporcentaje2021 <- sum(porcenestado2021, na.rm = TRUE) # creamos tibble con datos de codigo de entidad y casos positivos nueva2021 <- confirmEstado2021 %>% #agregamos porcentajes de acuerdo al total de pruebas positivas add_column(porcenestado2021)%>% #agregamos porcentajes del total de pruebas add_column(positividad2021) %>% #Agregamos el nombre de los estados por orden de codigo add_column(nombreEstado) # Mapa de positividad total -------------------------------------------------------------------- # de acuerdo al número de pruebas realizadas se calcula el porcentaje de las #pruebas que fueron seleccionadas como positivas. (por estado) #data(nueva) nueva$value <- nueva$positividad nueva$region <- nueva$ENTIDAD_RES # mxstate_choropleth(nueva, # num_colors = 1, # title = "Porcentaje de casos positivos", # legend = "%", # ) #Mapa interactivo bins = c(15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57, 60, 63, 66, 69, 72) pal <- colorBin("viridis", domain = nueva$value, bins=bins) mxstate_leaflet(nueva, pal, ~ pal(value), ~ sprintf("Estado: %s
Porcentaje de positividad : %s", ENTIDAD_FEDERATIVA , comma(value) )) %>% addLegend(position = "bottomright", pal = pal, values = nueva$value, title = "Percentaje
Positividad", labFormat = labelFormat(suffix = "%", )) %>% addTiles() %>% addMarkers(50, 50) %>% addControl("Mapa positividad de las pruebas totales", position = "bottomleft") %>% addProviderTiles("CartoDB.Positron") ``` Row ------------------------------------ ### Porcentaje 2020 ```{r} # Mapa 2020 --------------------------------------------------------------- # de acuerdo al número de pruebas realizadas se calcula el porcentaje de las #pruebas que fueron seleccionadas como positivas. (por estado del año 2020) data(nueva2020) nueva2020$value <- nueva2020$positividad2020 nueva2020$region <- nueva2020$ENTIDAD_RES # mxstate_choropleth(nueva, # num_colors = 1, # title = "Porcentaje de casos positivos", # legend = "%", # ) #Mapa interactivo bins=c(15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57, 60, 63, 66, 69, 72) pal <- colorBin("viridis", domain = nueva2020$value, bins=bins) mxstate_leaflet(nueva2020, pal, ~ pal(value), ~ sprintf("Estado: %s
Porcentaje de positividad : %s", ENTIDAD_FEDERATIVA , comma(value) )) %>% addLegend(position = "bottomright", pal = pal, values = nueva2020$value, title = "Percentaje
Positividad", labFormat = labelFormat(suffix = "%", )) %>% addTiles() %>% addMarkers(50, 50) %>% addControl("Mapa positividad de las pruebas en 2020", position = "bottomleft") %>% addProviderTiles("CartoDB.Positron") ``` ### Porcentaje 2021 ```{r} # Mapa 2021 --------------------------------------------------------------- # de acuerdo al número de pruebas realizadas se calcula el porcentaje de las #pruebas que fueron seleccionadas como positivas. (por estado del año 2021) data(nueva2021) nueva2021$value <- nueva2021$positividad2021 nueva2021$region <- nueva2021$ENTIDAD_RES # mxstate_choropleth(nueva2021, # num_colors = 1, # title = "Porcentaje de casos positivos", # legend = "%", # ) #Mapa interactivo bins = c(15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57, 60, 63, 66, 69, 72) pal <- colorBin("viridis", domain = nueva2021$value, bins=bins) mxstate_leaflet(nueva2021, pal, ~ pal(value), ~ sprintf("Estado: %s
Porcentaje de positividad : %s", ENTIDAD_FEDERATIVA , comma(value) )) %>% addLegend(position = "bottomright", pal = pal, values = nueva2021$value, title = "Percentaje
Positividad", labFormat = labelFormat(suffix = "%", )) %>% addTiles() %>% addMarkers(50, 50) %>% addControl("Mapa positividad de pruebas en 2021", position = "bottomleft") %>% addProviderTiles("CartoDB.Positron") ``` ```{r} # Carga de datos ---------------------------------------------------------- #Se importan los datos como un tibble Vacunastotales <- readr::read_csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/vaccinations/vaccinations.csv") # Wrangle data ------------------------------------------------------------ #Se quiere trabajar con series de tiempo, entonces convertimos # a tsibble un objeto que tiene orientación a este tiempo de #procesamiento Vacunastotales_tsibble <- Vacunastotales %>% dplyr::mutate(Daily = as.Date(date)) %>% dplyr::select(-date) %>% tsibble::as_tsibble(key = location, index = Daily) #se hace una variable con los nombres de los paises de #LATAM para asi poder llamar la variable a buscar en #la base de datos si se requiere, esto esta pensado #en que la instrucción podría hacerse varias veces #entonces en teoría debería simplificar el código latam <- c("Mexico", "Argentina", "Colombia", "Chile", "Brazil", "Bolivia", "Costa Rica", "Ecuador", "Guatemala", "Panama", "Paraguay", "Peru", "Puerto Rico", "Dominican Republic") #Se encontro que era particularmente complicado mostrar #todos los datos en una sola gráfica, por lo tanto, #graficar por secciones y pegar con patchwork es una #opción viable, por lo que la variable length(latam) = 14 #entonces dividimos en 2 grupos para tener símetria. latam1 <- latam[1:7] latam2 <- latam[8:14] #latam == latam1 + latam2 #hacemos otro dafa frame que solo sea para los de #LATAM y asi trabajamos con un tsibble más pequeña Vacunas_latam_tsibble <- Vacunastotales_tsibble %>% dplyr::select( Daily, location, total_vaccinations, total_vaccinations_per_hundred, daily_vaccinations_per_million) %>% filter(location %in% latam) ``` Ranking Nacional ========================================= ### Calificación por estado para manejo de la pandemia ```{r} # # Importación de datos ---------------------------------------------------- # # # Descarga de datos desde la página web # # fecha <- "210415" # options(timeout = 700) # temp <- tempfile() # download.file("http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip", temp) # # # Datosmex2502 <- vroom::vroom(unz(temp, unzip(temp, list = TRUE) %>% pull(Name))) # unlink(temp) # # Entidades <- read_xlsx("Datos nacionales abiertos/201128 Catalogos.xlsx",sheet="Catálogo de ENTIDADES") # Selección de datos ------------------------------------------------------ #datos necesarios para la prueba FiltImpoData <- dplyr::select(Datosmex2502, `FECHA_INGRESO`, `ENTIDAD_RES`, `TOMA_MUESTRA_LAB`, `RESULTADO_LAB`, `TOMA_MUESTRA_ANTIGENO`, `RESULTADO_ANTIGENO`, `CLASIFICACION_FINAL`, `FECHA_DEF`, )%>% left_join(Entidades, by=c("ENTIDAD_RES"="CLAVE_ENTIDAD")) #Población en cada estado del país, con datos a 2020 poblacionEstado <- dplyr::select(df_mxstate_2020, `region`, `state_name`, `pop`, ) # Filtro de datos en tibbles --------------------------------------------------------- #datos confirmados confirm <- FiltImpoData %>% filter(`CLASIFICACION_FINAL`%in% c(1,2,3)) %>% drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) %>% #borramos los datos NA que generan más filas(son pocos) arrange(`FECHA_INGRESO`) #Casos terminados en muerte muertesConfirm <- FiltImpoData %>% filter(!is.na(`FECHA_DEF`)) %>% drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) #quitamos datos NA (no interfiere) #datos de las pruebas realizadas ese día en todo el país filtroPrueba <- FiltImpoData %>% dplyr::filter(`TOMA_MUESTRA_LAB`== 1 | `TOMA_MUESTRA_ANTIGENO`==1 ) %>% #seleccuón de datos con pruebas drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) #borrar datos NA (no afecta) # Medias moviles de los estados casos positivos ----------------------------------------------------- positivosXEstaXDia <- confirm %>% dplyr::group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% mutate(POSITIVOS=n()) %>% distinct(`FECHA_INGRESO`, .keep_all = TRUE) %>% arrange(`FECHA_INGRESO`) %>% dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `FECHA_DEF`, `POSITIVOS`, ) #promedio de los últimos catorce días positivosXEstaXDia %>% group_by(ENTIDAD_FEDERATIVA) %>% slice_tail(n = 14) # %>% # summarise(Promedio = mean(POSITIVOS)) #media movil de 14 días positivos_tsbl <- positivosXEstaXDia %>% ungroup() %>% as_tsibble(index = FECHA_INGRESO, key = ENTIDAD_FEDERATIVA) %>% mutate( `14-MA` = slider::slide_dbl(POSITIVOS, mean, .before = 14, .complete = TRUE) ) # #gráfica de los positivos con la medi movil # positivos_tsbl %>% # feasts::autoplot(POSITIVOS) + # geom_line(aes(y = `14-MA`), color = "black") + # facet_wrap(~ ENTIDAD_FEDERATIVA, scales = "free_y") + # theme(legend.position = "none") # Medias moviles de los estados casos negativos --------------------------- muertesXEstaXDia <- muertesConfirm %>% dplyr::group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% mutate(MUERTES=n()) %>% distinct(`FECHA_INGRESO`, .keep_all = TRUE) %>% arrange(`FECHA_INGRESO`) %>% dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `FECHA_DEF`, `MUERTES` ) #promedio de los últimos catorce días muertesXEstaXDia %>% group_by(ENTIDAD_FEDERATIVA) %>% slice_tail(n = 14) # %>% # summarise(Promedio = mean(MUERTES)) #media movil de 14 días muertes_tsbl <- muertesXEstaXDia %>% ungroup() %>% as_tsibble(index = FECHA_INGRESO, key = ENTIDAD_FEDERATIVA) %>% mutate( `14-MA` = slider::slide_dbl(MUERTES, mean, .before = 14, .complete = TRUE) ) # #gráfica de los positivos con la medi movil # muertes_tsbl %>% # feasts::autoplot(MUERTES) + # geom_line(aes(y = `14-MA`), color = "black") + # facet_wrap(~ ENTIDAD_FEDERATIVA, scales = "free_y") + # theme(legend.position = "none") # medias movil positivos por millon de habitantes ------------------------- positivosXEstaXDiaXmillon <- positivosXEstaXDia %>% left_join(poblacionEstado, by=c("ENTIDAD_RES"="region")) positivosXEstaXDiaXmillon$POSITIVOS <- (positivosXEstaXDiaXmillon$POSITIVOS*1000000)/positivosXEstaXDiaXmillon$pop #media movil de 14 días positivosmillon_tsbl <- positivosXEstaXDiaXmillon %>% ungroup() %>% as_tsibble(index = FECHA_INGRESO, key = ENTIDAD_FEDERATIVA) %>% mutate( `14-MA` = slider::slide_dbl(POSITIVOS, mean, .before = 14, .complete = TRUE) ) # media movil muertes por millon de habitantes ---------------------------- muertesXEstaXDiaXmillon <- muertesXEstaXDia %>% left_join(poblacionEstado, by=c("ENTIDAD_RES"="region")) muertesXEstaXDiaXmillon$MUERTES <- (muertesXEstaXDiaXmillon$MUERTES*1000000)/muertesXEstaXDiaXmillon$pop #media movil de 14 días muertesmillon_tsbl <- muertesXEstaXDiaXmillon %>% ungroup() %>% as_tsibble(index = FECHA_INGRESO, key = ENTIDAD_FEDERATIVA) %>% mutate( `14-MA` = slider::slide_dbl(MUERTES, mean, .before = 14, .complete = TRUE) ) # media movil de la positividad ------------------------------------------- PruePosiXEstaXDia <- filtroPrueba %>% dplyr::group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% mutate(PRUEBAS=n()) %>% distinct(`FECHA_INGRESO`, .keep_all = TRUE) %>% arrange(`FECHA_INGRESO`) %>% dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `FECHA_DEF`, `PRUEBAS`) %>% left_join(positivosXEstaXDia, positivosXEstaXDia, by= c("ENTIDAD_RES", "FECHA_INGRESO", "ENTIDAD_FEDERATIVA")) PruePosiXEstaXDia$POSITIVIDAD <- (PruePosiXEstaXDia$POSITIVOS/PruePosiXEstaXDia$PRUEBAS)*100 #media movil de 14 días positivdad_tsbl <- PruePosiXEstaXDia %>% ungroup() %>% as_tsibble(index = FECHA_INGRESO, key = ENTIDAD_FEDERATIVA) %>% mutate( `14-MA` = slider::slide_dbl(POSITIVIDAD, mean, .before = 14, .complete = TRUE) ) # Media movil de pruebas por cada 1000 habitantes -------------------------- pruebasXEstaXDia<- filtroPrueba %>% dplyr::group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% mutate(PRUEBAS=n()) %>% distinct(`FECHA_INGRESO`, .keep_all = TRUE) %>% arrange(`FECHA_INGRESO`) %>% dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `FECHA_DEF`, `PRUEBAS`) %>% left_join(poblacionEstado, by=c("ENTIDAD_RES"="region")) pruebasXEstaXDia$XMILHAB <- ((1000*pruebasXEstaXDia$PRUEBAS)/pruebasXEstaXDia$pop) #media movil de 14 días pruebas_tsbl <- pruebasXEstaXDia %>% ungroup() %>% as_tsibble(index = FECHA_INGRESO, key = ENTIDAD_FEDERATIVA) %>% mutate( `14-MA` = slider::slide_dbl(XMILHAB, mean, .before = 14, .complete = TRUE) ) # Indicadores por día en cada estado ------------------------------------- # #Por día hacemos un conteo de los casos que se confirmaron en cada estado # positivosXEstaXDia <- confirm %>% # dplyr::group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% # mutate(POSITIVOS=n()) %>% # distinct(`FECHA_INGRESO`, .keep_all = TRUE) %>% # arrange(`FECHA_INGRESO`) %>% # select(`FECHA_INGRESO`, # `ENTIDAD_RES`, # `ENTIDAD_FEDERATIVA`, # `FECHA_DEF`, # `POSITIVOS`, # )# %>% # # add_column(SUMS=NA) # # #Para generar las tablas de cada uno de los estados con su conteo # for(i in unique(positivosXEstaXDia$`ENTIDAD_RES`)) { # nam <- paste0("positivoE.", i ) # assign(nam, positivosXEstaXDia[positivosXEstaXDia$`ENTIDAD_RES`==i,]) # # } # # muertesXEstaXDia <- muertesConfirm %>% # dplyr::group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% # mutate(MUERTES=n()) %>% # distinct(`FECHA_INGRESO`, .keep_all = TRUE) %>% # arrange(`FECHA_INGRESO`) %>% # select(`FECHA_INGRESO`, # `ENTIDAD_RES`, # `ENTIDAD_FEDERATIVA`, # `FECHA_DEF`, # `MUERTES` # ) # for(i in unique(muertesXEstaXDia$`ENTIDAD_RES`)) { # nam <- paste("muertesE", i, sep = ".") # assign(nam, muertesXEstaXDia[muertesXEstaXDia$ENTIDAD_RES==i,]) # } # pruebasXEstaXDia <- filtroPrueba %>% # dplyr::group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% # mutate(PRUEBAS=n()) %>% # distinct(`FECHA_INGRESO`, .keep_all = TRUE) %>% # arrange(`FECHA_INGRESO`) %>% # select(`FECHA_INGRESO`, # `ENTIDAD_RES`, # `ENTIDAD_FEDERATIVA`, # `FECHA_DEF`, # `PRUEBAS`) # for(i in unique(pruebasXEstaXDia$`ENTIDAD_RES`)) { # nam <- paste("pruebasE", i, sep = ".") # assign(nam, pruebasXEstaXDia[pruebasXEstaXDia$ENTIDAD_RES==i,]) # # add_column(rollsumr("pruebasE".i$PRUEBAS, k = 14, fill = NA)) # # pruebasE.i$promedio <- rollmean(`PRUEBAS`, k = 14, fill = NA, aling="rigth") # } # for (i in tibble("pruebasE", i,sep="·")){ # tibble("pruebasE", i,sep="·")$sums <-rollsumr(PRUEBAS, k = 14, fill = NA) %>% # tibble("pruebasE", i,sep="·")$promedio <- rollmean(PRUEBAS, k = 14, fill = NA, aling="rigth") # } # Promedio al día indicadores por estados ------------------------------------------------------------- positivosXEstados <- confirm %>% group_by(`ENTIDAD_RES`) %>% mutate(Positivos=n()) %>% distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% arrange(`ENTIDAD_RES`) %>% dplyr::select( `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `ABREVIATURA`, `Positivos`) # #promedios positivos al día en cada estado # positivosXEstaXDia <- positivosXEstaXDia %>% # ungroup() %>% # group_by(`ENTIDAD_RES`) %>% # mutate( # PROM=mean(POSITIVOS) # # ) muertesXEstado <- muertesConfirm %>% group_by(`ENTIDAD_RES`) %>% mutate(Muertes=n()) %>% distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% arrange(`ENTIDAD_RES`) %>% dplyr::select(`ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `ABREVIATURA`, `Muertes`) # #promedios de muertes al día en cada estado # muertesXEstaXDia <- muertesXEstaXDia %>% # ungroup() %>% # group_by(`ENTIDAD_RES`) %>% # mutate( # PROM=mean(MUERTES) # # ) pruebasXEstado <- filtroPrueba %>% group_by(`ENTIDAD_RES`) %>% mutate(Pruebas=n()) %>% distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% arrange(`ENTIDAD_RES`) %>% dplyr::select(`ENTIDAD_RES`, # selección de datos necesarios `ENTIDAD_FEDERATIVA`, `ABREVIATURA`, `Pruebas`) # Por millon de habitantes ------------------------------------------------ posiXEstaXMillon <- ((1000000*positivosXEstados$Positivos)/poblacionEstado$pop) muerteXEstaXMillon <- ((1000000*muertesXEstado$Muertes)/poblacionEstado$pop) # Positividad ------------------------------------------------------------ PositividadIndica <- (positivosXEstados$Positivos/pruebasXEstado$Pruebas)*100 # Pruebas por mil habitantes --------------------------------------------- pruebasXEstaXMilhab <- ((1000*pruebasXEstado$Pruebas)/poblacionEstado$pop) # Tabla con datos finales xEstado ------------------------------------------------- indicadoresFinal <- positivosXEstados %>% tibble::add_column(muertesXEstado$Muertes) %>% tibble::add_column(pruebasXEstado$Pruebas) %>% tibble::add_column(posiXEstaXMillon) %>% tibble::add_column(muerteXEstaXMillon) %>% tibble::add_column(PositividadIndica) %>% tibble::add_column(pruebasXEstaXMilhab) indicadoresFinal <- indicadoresFinal %>% ungroup() %>% group_by(`ENTIDAD_FEDERATIVA`) %>% mutate( SUM= sum(`Positivos`, `muertesXEstado$Muertes`, posiXEstaXMillon, muerteXEstaXMillon, PositividadIndica, pruebasXEstaXMilhab, na.rm = TRUE), PROM = (SUM/6) ) PromIndica <- indicadoresFinal %>% dplyr::select(`ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `PROM`) # summary(PromIndica) # Normalización ---------------------------------------------------------- # library(caret) # # # preproc2 <- preProcess(PromIndica[,c(1:3)], method=c("range")) # # norm2 <- predict(preproc2, PromIndica[,c(1:3)]) # # summary(norm2) normalize <- function(x) { return (((x - min(x))*(100) / (max(x) - min(x)))) } calificacion <- function(x) { return (100-(((x - min(x))*(100) )/ (max(x) - min(x)))) } PromIndica$NORM <- normalize(PromIndica$PROM) PromIndica$AVERAGE <- calificacion(PromIndica$PROM) # Tabla Calificación ----------------------------------------------------- calif <- PromIndica %>% dplyr::select(`ENTIDAD_FEDERATIVA`, `AVERAGE` ) %>% arrange(desc(AVERAGE)) colnames(calif)[colnames(calif)=="ENTIDAD_FEDERATIVA"] <- "ESTADO" #Tabla que muestra el número de pruebas que se hacen por día en los estados formattable(calif, #llamo datos align =c("l","c"), #Para alinear los datos de la tabla cada "" es una columna list(`ESTADO` = formatter( #datos específicos "span", style = ~ formattable::style(color = "grey",font.weight = "bold")), `AVERAGE` = color_tile("transparent", "orange")# me crea una barra roja con proporción a los datos ) ) ``` Comparativa entre países (Contagios) ========================================= ```{r} #Carga de datos que se necesitan para generar los datos de este sección nuevos_casos_mundiales <- read_csv("https://raw.github.com/owid/covid-19-data/master/public/data/jhu/full_data.csv") casos_por_millon <- read_csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/jhu/new_cases_per_million.csv") # creación de variables que se necesitan para esta sección #vector para la selección de paises con población similar poblacion_similiar <- c("Mexico", "Japan", "Russia", "Bangladesh", "Philippines") #Paises de LATAM latam <- c("Mexico", "Argentina", "Colombia", "Chile", "Brazil", "Bolivia", "Costa Rica", "Ecuador", "Guatemala", "Panama", "Paraguay", "Peru", "Puerto Rico", "Dominican Republic") #Para la grafica GraphLatam Comparativa_casos_latam <- casos_por_millon %>% dplyr::select(date, matches(latam)) %>% pivot_longer( cols = 'Mexico':'Dominican Republic', names_to = "Paises", values_to = "Casos_por_millon" ) %>% filter( Paises != "Ecuador") Comparativa_casos_latam_tsbl<- Comparativa_casos_latam %>% as_tsibble( index = date, key = Paises ) ``` Column ------------------------------------ ### Escenario mundial (población similar) ```{r} Comparativa_nuevos_casos <- nuevos_casos_mundiales %>% ggplot(aes(x = date, y = new_cases, group = location)) + geom_line(color = "grey") + geom_line(data = nuevos_casos_mundiales %>% filter(location %in% poblacion_similiar), aes(color = location), size = 1) + scale_y_log10() Comparativa_nuevos_casos ``` Column ------------------------------------ ### Escenario LATAM ```{r} GraphLatam <- Comparativa_casos_latam_tsbl %>% filter(Paises != "Ecuador") %>% #Se elimina ecuador de la lista de paises por datos críticos negativos as_tsibble( index = date )%>% ggplot() + geom_line(mapping = aes(x = date, y = Casos_por_millon, color = Paises)) + facet_wrap(~ Paises, scales = "free_y") + theme(legend.position = "none") GraphLatam ``` Vacunación en LATAM ========================================= ```{r} #Datos de manejo y de carga para generar las visualizaciones en esta seccion #carga de datos #Se importan los datos como un tibble Vacunastotales <- readr::read_csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/vaccinations/vaccinations.csv") #wrangle #Se quiere trabajar con series de tiempo, entonces convertimos # a tsibble un objeto que tiene orientación a este tiempo de #procesamiento Vacunastotales_tsibble <- Vacunastotales %>% dplyr::mutate(Daily = as.Date(date)) %>% dplyr::select(-date) %>% tsibble::as_tsibble(key = location, index = Daily) #se hace una variable con los nombres de los paises de #LATAM para asi poder llamar la variable a buscar en #la base de datos si se requiere, esto esta pensado #en que la instrucción podría hacerse varias veces #entonces en teoría debería simplificar el código latam <- c("Mexico", "Argentina", "Colombia", "Chile", "Brazil", "Bolivia", "Costa Rica", "Ecuador", "Guatemala", "Panama", "Paraguay", "Peru", "Puerto Rico", "Dominican Republic") #Se encontro que era particularmente complicado mostrar #todos los datos en una sola gráfica, por lo tanto, #graficar por secciones y pegar con patchwork es una #opción viable, por lo que la variable length(latam) = 14 #entonces dividimos en 2 grupos para tener símetria. latam1 <- latam[1:7] latam2 <- latam[8:14] #latam == latam1 + latam2 #hacemos otro data frame que solo sea para los de #LATAM y asi trabajamos con un tsibble más pequeña Vacunas_latam_tsibble <- Vacunastotales_tsibble %>% dplyr::select( Daily, location, total_vaccinations, total_vaccinations_per_hundred, daily_vaccinations_per_million) %>% dplyr::filter(location %in% latam) #Tratando los valores faltantes y los que estan fuera de rango #VLT = contracción para Vacunas_latam_tsibble VLT_miss <- Vacunas_latam_tsibble %>% #filter(location %in% latam1) %>% #anti_join(outliers) %>% tsibble::fill_gaps() #aqui se remplazan por valores faltantes #fill(direction = "down") #A continuacion hacemos un modelo ARIMA que se ajuste #a los datos que cotienen "valores faltantes" VLT_fill <- VLT_miss %>% fabletools::model(ARIMA(total_vaccinations_per_hundred)) %>% fabletools::interpolate(VLT_miss) ``` Row ------------------------------------ ### Escenario general ```{r} #Gráfica que representa el escenario general para los paises #de latam en el tiempo vacunados por cada 100 EscenarioLatam <- ggplot(data = Vacunas_latam_tsibble) + geom_line(mapping = aes(x = Daily, y = total_vaccinations_per_hundred, color = location)) + labs(x = 'meses', y = 'Vacunas aplicadas por cada 100') plotly::ggplotly(EscenarioLatam) #Notas de el gráifco EscenarioLatam #muestra una tendencia creciente #con temporalidad variable #No hay evidencia de comportmaiento ciclico EscenarioLatam <- ggplot(data = Vacunas_latam_tsibble) + geom_line(mapping = aes(x = Daily, y = total_vaccinations_per_hundred, color = location)) + labs(title = 'Escenario general de vacunación en LATAM ', x = 'meses', y = 'Vacunas aplicadas por cada 100') #Gráfica que representa el escenario general para los paises #de latam en el tiempo vacunados por cada 100 (rellenado) EscenarioLatam_fill <- ggplot(data = VLT_fill) + geom_line(mapping = aes(x = Daily, y = total_vaccinations_per_hundred, color = location)) + labs(title = 'Escenario general de vacunación en LATAM (sin valores faltantes)', x = 'meses', y = 'Vacunas aplicadas por cada 100') EscenarioLatam_Comparacion = EscenarioLatam + EscenarioLatam_fill EscenarioLatam_Comparacion ``` ### Estacionalidad (Mensual) ```{r} # #Visualización por periocidad ------------------------------------------- #Utilizando la función gg_season para hacer graficas #de la vacunación (2 gráficas por pais correspondiente a los # 2 años de los que se tienen datos) por mes. Vacunas_latam_tsibble %>% filter(location %in% latam1) %>% gg_season(total_vaccinations_per_hundred, labels = "both") + labs(y = "Vacunas aplicadas por cada 100", x = "Meses", title = "Vacunación por meses en los diferentes paises de LATAM") + expand_limits(x = ymd(c("2021-02","2021-04"))) -> g1 #se repite el codigo para hacer lo mismo y luego juntarlos #con el apoyo de patch work Vacunas_latam_tsibble %>% filter(location %in% latam2) %>% gg_season(total_vaccinations_per_hundred, labels = "both") + labs(y = "Vacunas aplicadas por cada 100", x = "Meses", title = "Vacunación por meses en los diferentes paises de LATAM") + expand_limits(x = ymd(c("2021-02","2021-04"))) -> g2 #No se estiliza que la asignación vaya hasta el final #pues transgrede con el estilo del código, pero se recomienda #en el libro de forescasting para darle "fluidez" a la lectura #del código #Se encuentra interesante que en marzo la mayoría de los paises #tienen una linea constante #Méxio y chile empezaron la vacunación en las últimas semanas #de diciembre # Visualización: Integración de los gráficos con PATCHWORK ----------------------------- #Establecemos un layout, que es basicamente un # para los espacios en blanco, y letras #para los lugares que deseamos que ocupe la letra layout <- ' AAAABBBB AAAABBBB AAAABBBB ' #cambiamos el lugar de las letras en el layout por nuestrras gráficas wrap_plots(A = g1, B = g2, design = layout) ``` ### Estacionalidad (semanal por mes) ```{r} #Aquí vemos las gráficas anteriores más a detalle, pues podemos #ver en que semanas de cada mes hay crecimiento Vacunas_latam_tsibble %>% filter(location %in% latam1) %>% gg_season(total_vaccinations_per_hundred, period = "month") + labs(y = "Vacunas aplicadas por cada 100", x = "Periodicidad de las semanas del mes", title = " Vacunación por semanana de los diferentes meses en los paises de LATAM") + expand_limits(x = ymd(c("2021-02","2021-04"))) -> g3 #repetimos el código para la sección 2 Vacunas_latam_tsibble %>% filter(location %in% latam2) %>% gg_season(total_vaccinations_per_hundred, period = "month") + labs(y = "Vacunas aplicadas por cada 100", x = "Periodicidad de las semanas del mes", title = " Vacunación por semanana de los diferentes meses en los paises de LATAM") + expand_limits(x = ymd(c("2021-02","2021-04"))) -> g4 # Visualización: Integración de los gráficos con PATCHWORK ----------------------------- #Establecemos un layout, que es basicamente un # para los espacios en blanco, y letras #para los lugares que deseamos que ocupe la letra layout <- ' AAAABBBB AAAABBBB AAAABBBB ' #cambiamos el lugar de las letras en el layout por nuestrras gráficas wrap_plots(A = g3, B = g4, design = layout) ``` Vacunación en LATAM (Pronósticos) ========================================= Column ----------------------------------- ### TSLM ```{r} # Modelo TSLM ------------------------------------------------------------- #https://www.rdocumentation.org/packages/forecast/versions/8.14/topics/tslm #Descripción #Fit a linear model with time series components #tslm is used to fit linear models to time series including trend and seasonality components. # Definición del modelo TSLM(total_vaccinations_per_hundred ~ trend()) # Entrenamiento del modelo (Estimación) fit_TSLM <- Vacunas_latam_tsibble %>% fabletools::model(Modelo_tendencia = TSLM(total_vaccinations_per_hundred ~ trend())) fit_TSLM #Para datos rellenados fit_TSLM_fill <- VLT_fill %>% fabletools::model(Modelo_tendencia = TSLM(total_vaccinations_per_hundred ~ trend())) fit_TSLM_fill # Revisar el desempeño del modelo (evaluación) # Producir pronósticos #Se genera la tabla de pronósticos, el cual va ser #una tabla de tipo fable (objeto) es decir #forecasting table fcst_TSLM <- fit_TSLM %>% forecast(h = 15) #se hace para los siguientes 3 meses #pues los datos que se tienen hasta el momento # son de 4 - 5 meses fcst_TSLM #tabla de pronósticos, datos rellenados fcst_TSLM_fill <- fit_TSLM_fill %>% forecast(h = 15) fcst_TSLM_fill # Visualización de la forecasting table #para grupo 1 latama fcst_TSLM %>% dplyr::filter(location %in% latam1) %>% autoplot(Vacunas_latam_tsibble) + ggtitle('Vacunas en LATAM') + ylab('Vacunas aplicadas por cada 100') -> fcst_TSLM_g1 #para grupo 1 latam (rellenado) fcst_TSLM_fill %>% dplyr::filter(location %in% latam1) %>% autoplot(VLT_fill) + ggtitle('Vacunas en LATAM') + ylab('Vacunas aplicadas por cada 100') -> fcst_TSLM_fill_g1 #para grupo 2 latam fcst_TSLM %>% dplyr::filter(location %in% latam2) %>% autoplot(Vacunas_latam_tsibble) + ggtitle('Vacunas en LATAM') + ylab('Vacunas aplicadas por cada 100') -> fcst_TSLM_g2 #para grupo 2 latam (rellenado) fcst_TSLM_fill %>% dplyr::filter(location %in% latam2) %>% autoplot(VLT_fill) + ggtitle('Vacunas en LATAM') + ylab('Vacunas aplicadas por cada 100') -> fcst_TSLM_fill_g2 #integración de las visualizaciones fcst_TSLM_g3 = fcst_TSLM_g1 + fcst_TSLM_fill_g1 + fcst_TSLM_g2 + fcst_TSLM_fill_g2 fcst_TSLM_g3 ``` Column ----------------------------------- ### ETS ```{r} # Modelo ETS (suavización exponencial con tendencia) ---------------------------- #https://www.rdocumentation.org/packages/forecast/versions/8.14/topics/ets #ETS = Exponential smoothing state space model #Description # Returns ETS model applied to "y" #Parámetros estimados #Estimamos alfa (entre 0 y 1, la tasa a la que disminuye "el peso" de los datos en el modelo, tambien conocida como el parametro de suavizacion) #L0 o Lt (nivel, o valor suavizado) #Beta (entre 0 y 1, es el coefficiente que representa la pendiente de la "tendencia" ) # 'A' es para 'aditivo' , 'M' para multiplicativo y 'N' para ninguno # Como nuestros datos tienen una tendencia marcada, seleccionmos que tanto #el error como la tendencia sean "aditivos" fit_ETS_trend <- VLT_fill %>% model(ETS(total_vaccinations_per_hundred ~ error('A') + trend('A') + season('N'))) #Generamos el pronóstico para 5 pasos después fcst_ETS_trend <- fit_ETS_trend %>% forecast(h = 15) %>% autoplot(VLT_fill) + facet_wrap(~location, ncol = 3, scales = 'free_y') + labs(title = 'Pronóstico de vacunas latam con ETS', x = 'meses', y = 'Vacunas aplicadas por cada 100') -> fcst_ETS_trend_g1 #El método de Holt es el que nos permite hacer suavizacion #exponencial para datos con tendencia #Holt tiene un problema, que la tendencia solo se establece #como creciente o decreciente. Por lo que se desarrollo #una funcion que hace este metodo pero amortiguado # phi es el factor de "amortiguamiento", donde phi # con un valor igual a 1, es identico al metodo de Holt sin # amortiguamiento #Ad -> aditive damped fit_ETS_trendDamped <- VLT_fill %>% model(ETS(total_vaccinations_per_hundred ~ error('A') + trend('Ad') + season('N'))) fcst_ETS_trendDamped <- fit_ETS_trendDamped %>% forecast(h = 15) %>% autoplot(VLT_fill) + facet_wrap(~location, ncol = 3, scales = 'free_y') + labs(title = 'pronóstico de vacunas latama con ETS amortiguado', x = 'meses', y = 'Vacunas aplicadas por cada 100') -> fcst_ETS_trendDamped_g1 fcst_ETS_comparacion = fcst_ETS_trend_g1 + fcst_ETS_trendDamped_g1 fcst_ETS_comparacion ```